home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / opaque.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-09  |  3.1 KB  |  107 lines
  1. /* Opaque Lisp objects.
  2.    Copyright (C) 1993, 1994 Sun Microsystems, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Not in FSF. */
  21.  
  22. /* Written by Ben Wing, October 1993. */
  23.  
  24. /* "Opaque" is used internally to hold keep track of allocated memory
  25.    so it gets GC'd properly, and to store arbitrary data in places
  26.    where a Lisp_Object is required and which may get GC'd. (e.g.  as
  27.    the argument to record_unwind_protect()).  Once created in C,
  28.    opaque objects cannot be resized.
  29.  
  30.    OPAQUE OBJECTS SHOULD NEVER ESCAPE TO THE LISP LEVEL.  Some code
  31.    depends on this.  As such, opaque objects are a generalization
  32.    of the Qunbound marker.
  33.  */
  34.  
  35. #include <config.h>
  36. #include "lisp.h"
  37. #include "opaque.h"
  38.  
  39. /**********************************************************************/
  40. /*                          OPAQUE OBJECTS                            */
  41. /**********************************************************************/
  42.  
  43. Lisp_Object Qopaquep;
  44. static Lisp_Object mark_opaque (Lisp_Object, void (*) (Lisp_Object));
  45. static unsigned int sizeof_opaque (CONST void *header);
  46. static void print_opaque (Lisp_Object obj, Lisp_Object printcharfun,
  47.               int escapeflag);
  48. DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque,
  49.                     mark_opaque, print_opaque, 0, 0, 0,
  50.                     sizeof_opaque, struct Lisp_Opaque);
  51.  
  52. static Lisp_Object
  53. mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object))
  54. {
  55.   if (XOPAQUE_MARKFUN (obj))
  56.     return (XOPAQUE_MARKFUN (obj)) (obj, markobj);
  57.   else
  58.     return Qnil;
  59. }
  60.  
  61. /* Should never, ever be called. (except by an external debugger) */
  62. static void
  63. print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  64. {
  65.   char buf[200];
  66.   sprintf (buf, "#<INTERNAL EMACS BUG (opaque, size=%d) 0x%x>",
  67.        (LISP_WORD_TYPE) XOPAQUE_SIZE (obj),
  68.        (LISP_WORD_TYPE) XPNTR (obj));
  69.   write_c_string (buf, printcharfun);
  70. }
  71.  
  72. static unsigned int
  73. sizeof_opaque (CONST void *header)
  74. {
  75.   struct Lisp_Opaque *p = (struct Lisp_Opaque *) header;
  76.   return sizeof (*p) + p->size - 1;
  77. }
  78.  
  79. Lisp_Object
  80. make_opaque (int size, void *data)
  81. {
  82.   struct Lisp_Opaque *p = alloc_lcrecord (sizeof (*p) + size - 1,
  83.                       lrecord_opaque);
  84.   Lisp_Object val;
  85.  
  86.   p->markfun = 0;
  87.   p->size = size;
  88.   if (data)
  89.     memcpy (p->data, data, size);
  90.   else
  91.     memset (p->data, 0, size);
  92.   XSETOPAQUE (val, p);
  93.   return val;
  94. }
  95.  
  96. Lisp_Object
  97. make_opaque_ptr (void *val)
  98. {
  99.   return make_opaque (sizeof (val), (void *) &val);
  100. }
  101.  
  102. Lisp_Object
  103. make_opaque_long (long val)
  104. {
  105.   return make_opaque (sizeof (val), (void *) &val);
  106. }
  107.